home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / tclmotif.1 / tclmotif / tm.1.2 / src / tmMain.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-03  |  12.6 KB  |  536 lines
  1. /* 
  2.  * main.c --
  3.  *
  4.  *    This file contains the main program for "moat", a windowing
  5.  *    shell based on Motif and Tcl.  It also provides a template that
  6.  *    can be used as the basis for main programs for other Tcl/Motif
  7.  *    applications.
  8.  *
  9.  * Copyright 1993 Jan Newmarch, University of Canberra.
  10.  * Permission to use, copy, modify, and distribute this
  11.  * software and its documentation for any purpose and without
  12.  * fee is hereby granted, provided that the above copyright
  13.  * notice appear in all copies.  The author
  14.  * makes no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without
  16.  * express or implied warranty.
  17.  
  18.  *
  19.  * Copyright 1990-1992 Regents of the University of California.
  20.  * Permission to use, copy, modify, and distribute this
  21.  * software and its documentation for any purpose and without
  22.  * fee is hereby granted, provided that the above copyright
  23.  * notice appear in all copies.  The University of California
  24.  * makes no representations about the suitability of this
  25.  * software for any purpose.  It is provided "as is" without
  26.  * express or implied warranty.
  27.  */
  28.  
  29. #ifndef lint
  30. static char rcsid[] = "$Header: /usrs/tm/RCS/main.c,v 1.2 1993/07/14 20:01:43 jan Exp jan $";
  31. #endif
  32. /*
  33. #include "tkConfig.h"
  34. #include "tkInt.h"
  35. */
  36. #include "tm.h"
  37. #include "tmFuncs.h"
  38. #include <X11/Xos.h>
  39.  
  40. /*
  41.  * Declarations for library procedures:
  42.  */
  43.  
  44. extern int isatty();
  45.  
  46. /*
  47.  * Command used to initialize moat:
  48.  */
  49.  
  50. char *tcl_RcFileName = NULL;
  51.  
  52. char *prompt;
  53.  
  54. /*
  55.  * Global variables used by the main program:
  56.  */
  57.  
  58. static Widget toplevel;
  59. static Tcl_Interp *interp;    /* Interpreter for this application. */
  60. static Tcl_DString command;    /* Used to assemble lines of terminal input
  61.                  * into Tcl commands. */
  62. static int tty;            /* Non-zero means standard input is a
  63.                  * terminal-like device.  Zero means it's
  64.                  * a file. */
  65. /*
  66. Tcl_HashTable WidgetTable; */    /* Table to locate info about each widget */
  67. /*
  68.  * Command-line options:
  69.  */
  70.  
  71. char *fileName = NULL;
  72. char *name = NULL;
  73.  
  74. static XrmOptionDescRec options[] =
  75. {
  76.     {"-file", "file", XrmoptionSepArg, NULL},
  77.     {"-f",    "file", XrmoptionSepArg, NULL}
  78. };
  79.  
  80. static XtResource resources[] =
  81. {
  82.     {XtNfile,
  83.      XtCFile,
  84.      XtRString,
  85.      sizeof(String),
  86.      XtOffset(Tm_ResourceTypePtr, fileName),
  87.      XmRImmediate,
  88.      NULL
  89.     }
  90. };
  91.  
  92.  
  93. /*
  94.  * Forward declarations for procedures defined later in this file:
  95.  */
  96.  
  97. static void        StdinProc _ANSI_ARGS_((XtPointer clientData,
  98.                 int *fid, XtInputId *id));
  99.  
  100. /*
  101.  * The following structure defines all of the commands supported by
  102.  * Tm, and the C procedures that execute them.
  103.  */
  104.  
  105. typedef struct {
  106.     char *name;            /* Name of command. */
  107.     int (*cmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
  108.         int argc, char **argv));
  109.                 /* Command procedure. */
  110. } TmCmd;
  111.  
  112.  
  113. void Tm_Init ()
  114. {
  115.     register TmCmd *cmdPtr;
  116.     char *libDir;
  117.  
  118.     /*
  119.      * Bind in Tm's commands.
  120.      */
  121.  
  122.     Tm_LoadWidgetCommands (interp);
  123.  
  124.     /*
  125.      * Set variables for the intepreter.
  126.      */
  127.  
  128.     libDir = getenv("TM_LIBRARY");
  129.     if (libDir == NULL) {
  130.     libDir = TM_LIBRARY;
  131.     }
  132.     Tcl_SetVar(interp, "tm_library", libDir, TCL_GLOBAL_ONLY);
  133.     Tcl_SetVar(interp, "tm_version", TM_VERSION, TCL_GLOBAL_ONLY);
  134.     Tcl_SetVar(interp, "tmVersion", TM_VERSION, TCL_GLOBAL_ONLY);
  135.  
  136.     /*
  137.      * Initialize hash table containing info about each widget
  138.      */
  139. /*
  140.     Tcl_InitHashTable(&WidgetTable, TCL_STRING_KEYS);
  141. */
  142.  
  143. }
  144.  
  145. /*
  146.  *----------------------------------------------------------------------
  147.  *
  148.  * Tcl_AppInit --
  149.  *
  150.  *      This procedure performs application-specific initialization.
  151.  *      Most applications, especially those that incorporate additional
  152.  *      packages, will have their own version of this procedure.
  153.  *
  154.  * Results:
  155.  *      Returns a standard Tcl completion code, and leaves an error
  156.  *      message in interp->result if an error occurs.
  157.  *
  158.  * Side effects:
  159.  *      Depends on the startup script.
  160.  *
  161.  *----------------------------------------------------------------------
  162.  */
  163.  
  164. int
  165. Tcl_AppInit(interp)
  166.     Tcl_Interp *interp;
  167. {
  168.     /*
  169.      * Call the init procedures for included packages.  Each call should
  170.      * look like this:
  171.      *
  172.      * if (Mod_Init(interp) == TCL_ERROR) {
  173.      *     return TCL_ERROR;
  174.      * }
  175.      *
  176.      * where "Mod" is the name of the module.
  177.      */
  178.  
  179.     /*
  180.      * Call Tcl_CreateCommand for application-specific commands, if
  181.      * they weren't already created by the init procedures called above.
  182.      */
  183.  
  184.     /*
  185.      * Specify a user-specific startup file to invoke if the application
  186.      * is run interactively.  Typically the startup file is "~/.apprc"
  187.      * where "app" is the name of the application.  If this line is deleted
  188.      * then no user-specific startup file will be run under any conditions.
  189.      */
  190.  
  191.     tcl_RcFileName = "~/.moatrc";
  192.     return TCL_OK;
  193. }
  194.  
  195.  
  196. /*
  197.  *----------------------------------------------------------------------
  198.  * Tm_Class -
  199.  *    The tcl source filename is used to construct the class name as
  200.  *    follows: a leading 'x' is capitalised and so is the following
  201.  *    character, else the leading char is capitalised
  202.  *
  203.  * Result
  204.  *    the class name as a new string
  205.  *
  206.  * Side effects
  207.  *    None
  208.  *----------------------------------------------------------------------
  209.  */
  210.  
  211. char *
  212. Tm_Class(argc, argv)
  213.     int argc;
  214.     char **argv;
  215. {
  216.     char *path;
  217.     char *class;
  218.     int n;
  219.  
  220.     path = argv[0];
  221.     for (n = 1; n < argc - 1; n++) {
  222.     if (strcmp(argv[n], "-f") == 0 ||
  223.         strcmp(argv[n], "-file") == 0)
  224.         path = argv[n+1];
  225.     }
  226.  
  227.     class = strrchr(path, '/');
  228.     if (class == NULL)
  229.     class = path;
  230.     else class++;
  231.  
  232.     class = XtNewString(class);
  233.     if (class[0] == 'x') {
  234.     class[0] = 'X';
  235.     class[1] = toupper(class[1]);
  236.     } else
  237.     class[0] = toupper(class[0]);
  238.  
  239.     return class;
  240. }
  241.  
  242. /*
  243.  *----------------------------------------------------------------------
  244.  *
  245.  * main --
  246.  *
  247.  *    Main program for moat.
  248.  *
  249.  * Results:
  250.  *    None. This procedure never returns (it exits the process when
  251.  *    it's done
  252.  *
  253.  * Side effects:
  254.  *    This procedure initializes the moat world and then starts
  255.  *    interpreting commands;  almost anything could happen, depending
  256.  *    on the script being interpreted.
  257.  *
  258.  *----------------------------------------------------------------------
  259.  */
  260.  
  261. int
  262. main(argc, argv)
  263.     int argc;                /* Number of arguments. */
  264.     char **argv;            /* Array of argument strings. */
  265. {
  266.     char *args, *p, *msg;
  267.     char *class;
  268.     char buf[20];
  269.     int result;
  270.     int code;
  271.     XtAppContext appContext;
  272.     Tm_ResourceType main_resources;
  273.     Tm_Widget *wPtr;
  274.     static Tm_Display displayInfo;
  275.     XtActionsRec action;
  276.  
  277.     action.string = "exec";
  278.     action.proc = Tm_ActionsHandler;
  279.  
  280.     interp = Tcl_CreateInterp();
  281. #ifdef TCL_MEM_DEBUG
  282.     Tcl_InitMemory(interp);
  283. #endif
  284.  
  285.     Tm_Init ();
  286.     class = Tm_Class(argc, argv);
  287.  
  288.     toplevel = XtAppInitialize (&appContext, class, options, XtNumber(options),
  289.                 (unsigned int *) &argc, argv, NULL, NULL, 0);
  290.  
  291.     XtAppAddActions(appContext, &action, 1);
  292.  
  293.     displayInfo.commWidget = NULL;
  294.     displayInfo.toplevel = toplevel;
  295.     displayInfo.display = XtDisplay(toplevel);
  296.  
  297.     wPtr = (Tm_Widget *) ckalloc (sizeof (Tm_Widget));
  298.     wPtr -> interp = interp;
  299.     wPtr -> widget = toplevel;
  300.     wPtr -> pathName = XtNewString(".");
  301.     wPtr -> parent = ".";    /* kludge to stop later breakages */
  302.     wPtr -> displayInfo = &displayInfo;
  303.  
  304.     Tm_StoreWidgetInfo(".", wPtr, interp);
  305.  
  306.     Tcl_CreateCommand (interp, ".", Tm_AnyWidgetCmd,
  307.                  (ClientData) wPtr, (void (*) ()) NULL);
  308.  
  309.     XtAddCallback(toplevel, XmNdestroyCallback, Tm_DestroyWidgetHandler,
  310.     (XtPointer) wPtr);
  311.  
  312.     Tm_RegisterConverters(interp, appContext);
  313.  
  314.     /*
  315.      * Parse command-line arguments.
  316.      */
  317.     XtGetApplicationResources(toplevel, 
  318.         (XtPointer) &main_resources,
  319.         resources,
  320.         XtNumber(resources),
  321.         NULL,
  322.         0);
  323.     fileName = main_resources.fileName;
  324.  
  325.     if (name == NULL) {
  326.     if (fileName != NULL) {
  327.         p = fileName;
  328.     } else {
  329.         p = argv[0];
  330.     }
  331.     name = strrchr(p, '/');
  332.     if (name != NULL) {
  333.         name++;
  334.     } else {
  335.         name = p;
  336.     }
  337.     prompt = name;
  338.     } else {
  339.     prompt = name;
  340.     }
  341.  
  342.     /* 
  343.      * Register the interpreter for the send command
  344.      */
  345.     Tm_RegisterInterp(interp, name, &displayInfo);
  346.  
  347.     /*
  348.      * Initialize the Tm application and arrange to map the main window
  349.      * after the startup script has been executed, if any.  This way
  350.      * the script can withdraw the window so it isn't ever mapped
  351.      * at all.
  352.      */
  353.  
  354.  
  355.     /*
  356.      * Make command-line arguments available in the Tcl variables "argc"
  357.      * and "argv".
  358.      */
  359.  
  360.     args = Tcl_Merge(argc-1, argv+1);
  361.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  362.     ckfree(args);
  363.     sprintf(buf, "%d", argc-1);
  364.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  365.  
  366.     /*
  367.      * Invoke application-specific initialization.
  368.      */
  369.  
  370. /*
  371.     if (Tcl_AppInit(interp) != TCL_OK) {
  372.         fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
  373.     }
  374. */
  375.  
  376.     /*
  377.      * Execute moat's initialization script, followed by the script specified
  378.      * on the command line, if any.
  379.      */
  380.  
  381.     tty = isatty(0);
  382.     if (fileName != NULL) {
  383.     result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  384.     if (result != TCL_OK) {
  385.         goto error;
  386.     }
  387.     /* make imoat also read from stdin - JN */
  388.     {   char *p;
  389.  
  390.         p = strrchr(argv[0], '/');
  391.         if (p != NULL) {
  392.         p++;
  393.         } else {
  394.         p = argv[0];
  395.         }
  396.  
  397.         if (strcmp (p, "imoat") == 0) {
  398.         XtAppAddInput(appContext, 0, (XtPointer) XtInputReadMask,
  399.                 StdinProc, NULL);
  400.             fprintf(stderr, "%s: ", prompt);    /* changed from stdout - JN */
  401.             fflush(stderr);
  402.         } else {
  403.         tty = 0;
  404.         }
  405.     }
  406.     } else {
  407.     /*
  408.      * Commands will come from standard input.  Set up a handler
  409.      * to receive those characters and print a prompt if the input
  410.      * device is a terminal.
  411.      */
  412.  
  413.         if (tcl_RcFileName != NULL) {
  414.             Tcl_DString buffer;
  415.             char *fullName;
  416.    
  417.             fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
  418.             if (fullName == NULL) {
  419.                 fprintf(stderr, "%s\n", interp->result);
  420.             } else {
  421.                 if (access(fullName, R_OK) == 0) {
  422.                     code = Tcl_EvalFile(interp, fullName);
  423.                     if (code != TCL_OK) {
  424.                         fprintf(stderr, "%s\n", interp->result);
  425.                     }
  426.                 }
  427.             }
  428.             Tcl_DStringFree(&buffer);
  429.         }
  430.  
  431.     XtAppAddInput(appContext, 0, (XtPointer) XtInputReadMask,
  432.                 StdinProc, NULL);
  433.  
  434.     if (tty) {
  435.         fprintf(stderr, "%s: ", prompt);    /* changed from stdout - JN */
  436.         fflush(stderr);
  437.     }
  438.     }
  439.     fflush(stdout);
  440.     Tcl_DStringInit(&command);
  441.     (void) Tcl_Eval(interp, "update");
  442.  
  443.     /*
  444.      * Loop infinitely, waiting for commands to execute.  When there
  445.      * are no windows left, Tm_MainLoop returns and we clean up and
  446.      * exit.
  447.      */
  448.  
  449.     XtRealizeWidget (toplevel);
  450.  
  451.     XtAppMainLoop (appContext);
  452.  
  453. error:
  454.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  455.     if (msg == NULL) {
  456.     msg = interp->result;
  457.     }
  458.     fprintf(stderr, "%s\n", msg);
  459.     Tcl_Eval(interp, "destroy .");
  460.     exit(1);
  461. #ifndef sgi
  462.     return 0;            /* Needed only to prevent compiler warnings. */
  463. #endif
  464. }
  465.  
  466. /*
  467.  *----------------------------------------------------------------------
  468.  *
  469.  * StdinProc --
  470.  *
  471.  *    This procedure is invoked by the event dispatcher whenever
  472.  *    standard input becomes readable.  It grabs the next line of
  473.  *    input characters, adds them to a command being assembled, and
  474.  *    executes the command if it's complete.
  475.  *
  476.  * Results:
  477.  *    None.
  478.  *
  479.  * Side effects:
  480.  *    Could be almost arbitrary, depending on the command that's
  481.  *    typed.
  482.  *
  483.  *----------------------------------------------------------------------
  484.  */
  485.  
  486.     /* ARGSUSED */
  487. static void
  488. StdinProc(clientData, fid, id)
  489.     XtPointer clientData;        /* Not used. */
  490.     int *fid;
  491.     XtInputId *id;
  492. {
  493. #define BUFFER_SIZE 4000
  494.     char input[BUFFER_SIZE+1];
  495.     static int gotPartial = 0;
  496.     char *cmd;
  497.     int result, count;
  498.  
  499.     count = read(fileno(stdin), input, BUFFER_SIZE);
  500.     if (count <= 0) {
  501.     if (!gotPartial) {
  502.         if (tty) {
  503.         Tcl_Eval(interp, "destroy .");
  504.         exit(0);
  505.         } else {
  506.         XtRemoveInput(*id);
  507.         }
  508.         return;
  509.     } else {
  510.         count = 0;
  511.     }
  512.     }
  513.     cmd = Tcl_DStringAppend(&command, input, count);
  514.     if (count != 0) {
  515.         if ((input[count-1] != '\n') && (input[count-1] != ';')) {
  516.             gotPartial = 1;
  517.         }
  518.         if (!Tcl_CommandComplete(cmd)) {
  519.             gotPartial = 1;
  520.         }
  521.     }
  522.     gotPartial = 0;
  523.     result = Tcl_RecordAndEval(interp, cmd, 0);
  524.     Tcl_DStringFree(&command);
  525.     if (*interp->result != 0) {
  526.     if ((result != TCL_OK) || (tty)) {
  527.         printf("%s\n", interp->result);
  528.     }
  529.     }
  530.     if (tty) {
  531.     fprintf(stderr, "%s: ", prompt);    /* changed from stdout - JN */
  532.     fflush(stderr);
  533.     }
  534. }
  535.  
  536.